home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic1 / pro2 / fancycls.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-10-05  |  2.9 KB  |  76 lines
  1. 100  ' ***************************************************************
  2. 110  ' ***************************************************************
  3. 120  ' **                       GW-BASIC 3.23                       **
  4. 130  ' **                         FANCYCLS                          **
  5. 140  ' **                  Fancy Clear Screen Routine               **
  6. 150  ' **                        (c) 1990 by                        **
  7. 160  ' **                       Thomas Jaeger                       **
  8. 170  ' **                   1848 Andalucia Drive                    **
  9. 180  ' **                   El Paso, Texas 79935                    **
  10. 190  ' **                            USA                            **
  11. 200  ' ***************************************************************
  12. 210  ' ***************************************************************
  13. 220  '
  14. 230  '
  15. 240  ' This program is distributed under the shareware concept.
  16. 250  '
  17. 260  ' You can put this routine in your next GW-, TURBO-, POWER-, or
  18. 270  ' QuickBASIC routine. If you use this routine, please make a
  19. 280  ' distribution of US $1-5 to support this shareware concept.
  20. 290  '
  21. 300  ' Other routines will follow.
  22. 310  '
  23. 320  ' ----------------------------------------------------------------------
  24. 330  '
  25. 340  ' How about a fancy clear screen routine to impress your friends
  26. 350  ' in your next program?
  27. 360  ' Immediately you called FANCYCLS with GOSUB 10000, the screen starts
  28. 370  ' to crumble by coincidence. A great effect.
  29. 380  ' If you have a monochrome, graphics card, you have to change in line
  30. 390  ' 10060 hexa decimal number &HB800 into &HB000. If you don't want the
  31. 400  ' background color to be changed, just erase line 10090.
  32. 410  '
  33. 420  ' ----------------------------------------------------------------------
  34. 430  '
  35. 440  DIM F%(2000) ' dimension is necessary for screen
  36. 450  KEY OFF
  37. 460  '
  38. 470  ' >>>>> Your program starts hier <<<<<
  39. 480  '
  40. 490  ' The following code only fills the screen with asteriks to give a better
  41. 500  ' demonstration. You can leave this code out of your program.
  42. 510  '
  43. 520  WAITING$ = INKEY$
  44. 530  CLS
  45. 540  WHILE WAITING$ = ""
  46. 550     WHILE NOT ENDPRINT = -1
  47. 560        FOR COUNTER% = 1 TO 25
  48. 570           PRINT STRING$(80,"*");
  49. 580        NEXT COUNTER%
  50. 590        ENDPRINT = -1
  51. 600        LOCATE 13,35
  52. 610        PRINT " PRESS ANY KEY! "
  53. 620     WEND
  54. 630     WAITING$ = INKEY$
  55. 640  WEND
  56. 650  LOCATE 14,35
  57. 660  PRINT " WAIT A SECOND "
  58. 670  GOSUB 10000 ' call FANCYCLS subroutine
  59. 680  ' You probably want to end your program then.
  60. 690  END ' Program
  61. 9997   '
  62. 9998   ' Subroutine FANCYCLS
  63. 9999   '
  64. 10000  FOR COUNTER% = 0 TO 2000
  65. 10010     F%(COUNTER%) = COUNTER%
  66. 10020  NEXT COUNTER%
  67. 10030  FOR COUNTER% = 2000 TO 0 STEP -1
  68. 10040     SWAP F%(INT(RND(1) * COUNTER%)), F%(COUNTER)
  69. 10050  NEXT COUNTER%
  70. 10060  DEF SEG = &HB800  ' &HB000 if you have a hercules monochrome card
  71. 10070  FOR COUNTER% = 0 TO 2000
  72. 10080     POKE F%(COUNTER%) * 2,32
  73. 10090     POKE F%(COUNTER%) * 2 + 1,0  ' Background = black
  74. 10100  NEXT COUNTER%
  75. 10110  RETURN  ' to your main program
  76.